home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 12
/
Amiga Plus Sonderheft Amiga 12.iso
/
pd
/
spiele
/
klondike_adptools
/
install
/
datas
/
french.lha
/
5-MakeCardset.adpro
< prev
Wrap
Text File
|
1997-06-23
|
11KB
|
489 lines
/*
** MakeCardset.adpro :
**
** This ARexx script for ADPro v2.5 or higher,
** make a Klondike cardset with the tool 'reko'.
**
** Klondike & Reko Tools © Copyright Reko Productions - All Rights Reserved.
**
** $VER: MakeCardset/French v2.0 (16.06.97) Copyright © 1995-97 Lejardinier Olivier - All Rights Reserved
**
*/
/*
** ARexx Initializations.
*/
ADDRESS "ADPro"
OPTIONS RESULTS
ReturnCode = 0
/*
** Parse Arguments.
*/
PARSE ARG Mode
/*
** Constants Initializations.
*/
NL = '0A'X
DNL = NL || NL
FALSE = 0
TRUE = 1
/*
** Strings initializations.
*/
TITLE_Error = "Erreur :"
TITLE_Request = "Requête :"
TITLE_Confirm = "Confirmer :"
TITLE_Infos = "Informations :"
TITLE_SelectCardPic = "Sélectionner 1 image carte :"
MSG_Abort = "Abandonner ?"
MSG_ErrorCode = "Code d'erreur ="
MSG_ADProResult = "Résultat ADPro ="
MSG_UnableToSaveADProPrefs = "Impossible de sauver les prefs d'ADPro."
MSG_UnableToRestoreADProPrefs = "Impossible de restaurer les prefs d'ADPro."
MSG_YouMustSelectCardPic = "Vous DEVEZ sélectionner 1 image carte !"
MSG_UnableToLoadCardPic = "Impossible de charger l'image carte :"
MSG_CheckingCardPic = "Vérification de l'image carte :"
MSG_InvalidCardPicSize = "Les dimensions de l'image carte ne sont pas correctes"
MSG_MissingCardPic = "Image carte manquante !"
MSG_PlaceCardset = "Placer le jeu de cartes"
MSG_Into = "dans ?"
MSG_CreatingCardset = "Patientez SVP, création du jeu de cartes"
MSG_UnableToCreateCardset = "Impossible de créer le jeu de cartes"
MSG_DeleteCreatedCardPics = "Voulez-vous effacer les images cartes créées ?"
MSG_DeletingCardPics = "Patientez SVP, effacement des images cartes"
MSG_YouFindCardset = "Vous trouverez le jeu de cartes"
MSG_IntoDirectory = "dans le répertoire"
GAD_Abort = "Abandonner"
GAD_ContinueAbort = "Continuer|Abandonner"
GAD_SelectAbort = "Sélectionner|Abandonner"
GAD_Quit = "Quitter"
GAD_RetrySelectAbort = "Réessayer|Sélectionner|Abandonner"
GAD_RetryAbort = "Réessayer|Abandonner"
GAD_TestAbort = "Tester suivante|Abandonner"
GAD_YesNo = "Oui|Non"
/*
** Save the current ADPro environment.
*/
TempDefaults = "T:TempADProDefaults"
SAVE_DEFAULTS '"'TempDefaults'"'
IF ( RC ~= 0 ) THEN
DO
Text = MSG_UnableToSaveADProPrefs || MSG_ADProError ADPRO_RESULT
OKAY1 '"'Text'"'
END
/*
** Initializations of new ADPro environment.
*/
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
CLEAR_RAW
PSTATUS "UNLOCKED"
DISPLAYMESSAGE '""'
ADPRO_TO_FRONT
/*
** Get a previously created card picture and check it.
*/
CardPicsDir = GetPref( "KADPT.CardPicsDir" )
IF ( ( Mode = "AUTO" ) & ( CardPicsDir ~= "" ) ) THEN
DO
CardPicsBaseName = GetPref( "KADPT.CardPicsBaseName" )
CardPicPath = AddPart( CardPicsDir, AddExt( CardPicsBaseName, "003" ) )
RetVal = CheckCardPics( CardPicPath )
IF ( ( WORD( RetVal, 1 ) ~= 55 ) & ( WORD( RetVal, 1 ) ~= 59 ) ) THEN
DO
ReturnCode = 10
CALL Quit
END
END
ELSE
DO
Continue = FALSE
DO UNTIL ( Continue = TRUE )
IF ( CardPicsDir ~= "" ) THEN
GETFILE '"'TITLE_SelectCardPic'"' '"'ParseDir( CardPicsDir )'"' '""'
ELSE
GETFILE '"'TITLE_SelectCardPic'"'
IF ( RC ~= 0 ) THEN
DO
OKAYN '"'TITLE_Error'"' '"'MSG_YouMustSelectCardPic'"' '"'GAD_SelectAbort'"'
IF ( RC = 0 ) THEN
CALL ConfirmAbort
END
ELSE
DO
CardPicPath = ADPRO_RESULT
RetVal = CheckCardPics( CardPicPath )
IF ( ( WORD( RetVal, 1 ) = 55 ) | ( WORD( RetVal, 1 ) = 59 ) ) THEN
DO
SetPref( "KADPT.CardPicsDir", WORD( RetVal, 2 ) )
Continue = TRUE
END
END
END
END
CardPicsDir = WORD( RetVal, 2 )
CardPicsBaseName = WORD( RetVal, 3 )
NbCardPics = WORD( RetVal, 1 )
/*
** Free some memory.
*/
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
CLEAR_RAW
/*
** Get cardset destination.
*/
CardsetDir = GetPref( "KADPT.CardsetDir" )
IF ( CardsetDir = "" ) THEN
CardsetDir = CardPicsDir
Continue = FALSE
DO UNTIL ( Continue = TRUE )
Title = MSG_PlaceCardset "'" || AddExt( CardPicsBaseName, "REKO" ) || "'" MSG_Into
GETDIR '"'Title'"' '"'ParseDir( CardsetDir )'"'
IF ( RC ~= 0 ) THEN
CALL ConfirmAbort
ELSE
DO
CardsetDir = ADPRO_RESULT
Continue = TRUE
END
END
SetPref( "KADPT.CardsetDir", CardsetDir )
/*
** Create cardset.
*/
Continue = FALSE
DO UNTIL ( Continue = TRUE )
IF ( EXISTS( AddPart( CardPicsDir, "Card.REKO" ) ) ) THEN
ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, "Card.REKO" ) || '" FORCE QUIET'
CardsetName = AddExt( CardPicsBaseName, "REKO" )
Text = MSG_CreatingCardset CardsetName
DISPLAYMESSAGE '"'Text'"'
OldDir = PRAGMA( "DIRECTORY", CardPicsDir )
OldStack = PRAGMA( "STACK", 51200 )
ADDRESS COMMAND 'C:CPU >NIL: NOCACHE'
ADDRESS COMMAND 'C:Reko >NIL:' AddExt( CardPicsBaseName, "000" ) NbCardPics
ADDRESS COMMAND 'C:CPU >NIL: CACHE'
Dummy = PRAGMA( "STACK", OldStack )
Dummy = PRAGMA( "DIRECTORY", OldDir )
DISPLAYMESSAGE '""'
IF ( ~EXISTS( AddPart( CardPicsDir, "Card.REKO" ) ) ) THEN
DO
Text = MSG_UnableToCreateCardset || DNL || CardsetName
OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetryAbort'"'
IF ( RC = 0 ) THEN
CALL ConfirmAbort
END
ELSE
DO
IF ( ParseDir( CardsetDir ) ~= ParseDir( CardPicsDir ) ) THEN
DO
ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardsetDir, CardsetName ) || '" FORCE QUIET'
ADDRESS COMMAND 'C:Copy >NIL: FROM="' || AddPart( CardPicsDir, "Card.REKO" ) || '" TO "' AddPart( CardsetDir, CardsetName ) || '" QUIET BUF=64'
ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, "Card.REKO" ) || '" FORCE QUIET'
END
ELSE
ADDRESS COMMAND 'C:Rename >NIL: FROM="' || AddPart( CardPicsDir, "Card.REKO" ) || '" AS "' || AddPart( CardsetDir, CardsetName ) || '" QUIET'
ADDRESS COMMAND 'C:Filenote >NIL: FILE="' || AddPart( CardsetDir, CardsetName ) || '" COMMENT="Created with Klondike ADPTools © 1995-97 Lejardinier Olivier" QUIET'
Continue = TRUE
END
END
/*
** Ask to delete created cards
*/
OKAYN '"'TITLE_Request'"' '"'MSG_DeleteCreatedCardPics'"' '"'GAD_YesNo'"'
IF ( RC = 1 ) THEN
DO
DISPLAYMESSAGE '"'MSG_DeletingCardPics'"'
ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, AddExt( CardPicsBaseName, "#[0-9]" ) ) || '" QUIET'
DISPLAYMESSAGE '""'
END
/*
**
*/
Text = MSG_YouFindCardset || DNL || AddExt( CardPicsBaseName, "REKO" ) || DNL || MSG_IntoDirectory || DNL || CardsetDir
OKAYN '"'TITLE_Infos'"' '"'Text'"' '"'GAD_Quit'"'
/*
** Quit.
*/
Quit:
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
CLEAR_RAW
DISPLAYMESSAGE '""'
IF ( EXISTS( TempDefaults ) ) THEN
DO
LOAD_DEFAULTS '"'TempDefaults'"'
IF ( RC ~= 0 ) THEN
DO
Text = MSG_UnableToRestoreADProPrefs || ADProResult()
OKAY1 '"'Text'"'
END
ADDRESS COMMAND 'C:Delete >NIL: FILE="' || TempDefaults || '" QUIET'
END
EXIT ReturnCode
RETURN
/*
** Functions.
*/
CheckCardPics:
PARSE ARG CardPicPath
RetVal = "0"
Text = MSG_CheckingCardPic FilePart( CardPicPath )
DISPLAYMESSAGE '"'Text'"'
LOAD_TYPE "REPLACE"
Continue01 = FALSE
DO UNTIL ( Continue01 = TRUE )
LOADER "IFF" CardPicPath
IF ( RC ~= 0 ) THEN
DO
IF ( ADPRO_RESULT = "Aborted" ) THEN
CALL ConfirmAbort
ELSE
DO
Text = MSG_UnableToLoadCardPic || DNL || ParseString( CardPicPath ) || ADProResult()
IF ( Mode = "AUTO" ) THEN
Gad = GAD_RetryAbort
ELSE
Gad = GAD_RetrySelectAbort
OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
IF ( RC = 0 ) THEN
CALL ConfirmAbort "NOCHECK"
ELSE
IF ( RC = 2 ) THEN
Continue01 = TRUE
END
END
ELSE
DO
XSIZE
CardPicWidth = ADPRO_RESULT
YSIZE
CardPicHeight = ADPRO_RESULT
IF ( ( CardPicWidth = 88 ) & ( CardPicHeight = 130 ) ) THEN
DO
CardPicsDir = DirPart( CardPicPath )
CardPicsBaseName = DelExt( FilePart( CardPicPath ) )
Continue02 = TRUE
NbCardPics = 0
Extension = 0
DO UNTIL ( Continue02 = FALSE )
FileExtension = RIGHT( Extension, 3, '0' )
CardPicPath = AddPart( CardPicsDir, AddExt( CardPicsBaseName, FileExtension ) )
Text = MSG_CheckingCardPic FilePart( CardPicPath )
DISPLAYMESSAGE '"'Text'"'
IF ( EXISTS( CardPicPath ) ) THEN
DO
NbCardPics = NbCardPics + 1
Extension = Extension + 1
END
ELSE
Continue02 = FALSE
END
DISPLAYMESSAGE '""'
IF ( ( NbCardPics = 55 ) | ( NbCardPics = 59 ) ) THEN
DO
RetVal = NbCardPics CardPicsDir CardPicsBaseName
Continue01 = TRUE
END
ELSE
DO
Text = MSG_MissingCardPic || DNL || CardPicPath
IF ( Mode = "AUTO" ) THEN
Gad = GAD_Abort
ELSE
Gad = GAD_SelectAbort
OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
IF ( RC = 0 ) THEN
CALL ConfirmAbort "NOCHECK"
Continue01 = TRUE
END
END
ELSE
DO
Text = MSG_InvalidCardPicSize || DNL || CardPicPath
IF ( Mode = "AUTO" ) THEN
Gad = GAD_Abort
ELSE
Gad = GAD_SelectAbort
OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
IF ( RC = 0 ) THEN
CALL ConfirmAbort "NOCHECK"
Continue01 = TRUE
END
END
END
RETURN RetVal
/*
** Sub Routines
*/
ADProResult:
ADProResultText = DNL || MSG_ErrorCode RC || NL || MSG_ADProResult ADPRO_RESULT
RETURN ADProResultText
ConfirmAbort:
PARSE ARG Check
IF ( ( Mode = "AUTO" ) & ( Check = "NOCHECK" ) ) THEN
DO
ReturnCode = 20
CALL Quit
END
ELSE
DO
OKAYN '"'TITLE_Confirm'"' '"'MSG_Abort'"' '"'GAD_ContinueAbort'"'
IF ( RC = 0 ) THEN
DO
ReturnCode = 20
CALL Quit
END
RETURN
ParseString: PROCEDURE
PARSE ARG String
RETURN STRIP( String, 'B', '"' )
ParseDir: PROCEDURE
PARSE ARG Dir
Dir = ParseString( Dir )
Dir = STRIP( Dir, 'T', '/' )
RETURN Dir
DirPart: PROCEDURE
PARSE ARG Path
Path = ParseString( Path )
FNameSepPos = LASTPOS( '/', Path )
IF ( FNameSepPos = 0 ) THEN
RETURN LEFT( Path, LASTPOS( ':', Path ) )
ELSE
RETURN LEFT( Path, FNameSepPos - 1 )
FilePart:
PARSE ARG Path
Path = ParseString( Path )
FNameSepPos = LASTPOS( '/', Path )
IF ( FNameSepPos = 0 ) THEN
FNameSepPos = LASTPOS( ':', Path )
RETURN RIGHT( Path, LENGTH( Path ) - FNameSepPos )
AddPart:
PARSE ARG Dir, Name
LastChar = RIGHT( Dir, 1 )
IF (( LastChar ~= "/" ) & ( LastChar ~= ":" )) THEN
Dir = Dir || "/"
RETURN Dir || Name
AddExt:
PARSE ARG Name, Ext
RETURN Name || "." || Ext
DelExt:
PARSE ARG Name
PointPos = LASTPOS( '.', Name )
if ( PointPos ~= 0 ) THEN
Name = DELSTR( Name, PointPos )
RETURN Name
GetPref: PROCEDURE
PARSE ARG Name
Pref = GETCLIP( Name )
IF ( Pref = "" ) THEN
DO
IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "READ" ) ) THEN
DO
Pref = READLN( FileHandle )
Dummy = CLOSE( FileHandle )
END
END
RETURN Pref
SetPref: PROCEDURE
PARSE ARG Name, Pref
Dummy = SETCLIP( Name, Pref )
IF ( ~EXISTS( "ENVARC:Klondike_ADPTools" ) ) THEN
ADDRESS COMMAND 'C:MakeDir >NIL: ENVARC:Klondike_ADPTools'
IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "WRITE" ) ) THEN
DO
Dummy = WRITELN( FileHandle, Pref )
Dummy = CLOSE( FileHandle )
END
RETURN Pref